home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0080_Vector coding.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  5KB  |  191 lines
  1.  
  2. {$g+}
  3. program rotationalfield;
  4. { Source by Bas van Gaalen, Holland, PD }
  5. uses crt,dos;
  6. const
  7.   gseg : word = $a000;
  8.   dots = 459;
  9.   dist : word = 250;
  10.   sintab : array[0..255] of integer = (
  11.     0,3,6,9,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,60,63,66,68,
  12.     71,74,76,79,81,84,86,88,91,93,95,97,99,101,103,105,106,108,110,111,
  13.     113,114,116,117,118,119,121,122,122,123,124,125,126,126,127,127,127,
  14.     128,128,128,128,128,128,128,127,127,127,126,126,125,124,123,122,122,
  15.     121,119,118,117,116,114,113,111,110,108,106,105,103,101,99,97,95,93,
  16.     91,88,86,84,81,79,76,74,71,68,66,63,60,58,55,52,49,46,43,40,37,34,31,
  17.     28,25,22,19,16,13,9,6,3,0,-3,-6,-9,-13,-16,-19,-22,-25,-28,-31,-34,
  18.     -37,-40,-43,-46,-49,-52,-55,-58,-60,-63,-66,-68,-71,-74,-76,-79,-81,
  19.     -84,-86,-88,-91,-93,-95,-97,-99,-101,-103,-105,-106,-108,-110,-111,
  20.     -113,-114,-116,-117,-118,-119,-121,-122,-122,-123,-124,-125,-126,
  21.     -126,-127,-127,-127,-128,-128,-128,-128,-128,-128,-128,-127,-127,
  22.     -127,-126,-126,-125,-124,-123,-122,-122,-121,-119,-118,-117,-116,
  23.     -114,-113,-111,-110,-108,-106,-105,-103,-101,-99,-97,-95,-93,-91,
  24.     -88,-86,-84,-81,-79,-76,-74,-71,-68,-66,-63,-60,-58,-55,-52,-49,
  25.     -46,-43,-40,-37,-34,-31,-28,-25,-22,-19,-16,-13,-9,-6,-3);
  26. type
  27.   dotrec = record x,y,z : integer; end;
  28.   dotpos = array[0..dots] of dotrec;
  29. var dot : dotpos;
  30.  
  31. {----------------------------------------------------------------------------}
  32.  
  33. procedure setpal(col,r,g,b : byte); assembler; asm
  34.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  35.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  36.  
  37. procedure setvideo(mode : word); assembler; asm
  38.   mov ax,mode; int 10h end;
  39.  
  40. function esc : boolean; begin
  41.   esc := port[$60] = 1; end;
  42.  
  43. {----------------------------------------------------------------------------}
  44.  
  45. procedure init;
  46. var i : word; x,z : integer;
  47. begin
  48.   i := 0;
  49.   z := -100;
  50.   while z < 100 do begin
  51.     x := -100;
  52.     while x < 100 do begin
  53.       dot[i].x := x;
  54.       dot[i].y := -45;
  55.       dot[i].z := z;
  56.       inc(i);
  57.       inc(x,10);
  58.     end;
  59.     inc(z,9);
  60.   end;
  61.   for i := 0 to 63 do setpal(i,0,i,i);
  62. end;
  63.  
  64. {----------------------------------------------------------------------------}
  65.  
  66. procedure rotation;
  67. const yst = 1;
  68. var
  69.   xp : array[0..dots] of word;
  70.   yp : array[0..dots] of byte;
  71.   x,z : integer; n : word; phiy : byte;
  72. begin
  73.   asm mov phiy,0; mov es,gseg; cli; end;
  74.   repeat
  75.     asm
  76.       mov dx,03dah
  77.      @l1:
  78.       in al,dx
  79.       test al,8
  80.       jnz @l1
  81.      @l2:
  82.       in al,dx
  83.       test al,8
  84.       jz @l2
  85.     end;
  86.     setpal(0,0,0,10);
  87.     for n := 0 to dots do begin
  88.       asm
  89.         mov si,n
  90.         mov al,byte ptr yp[si]
  91.         cmp al,200
  92.         jae @skip
  93.         shl si,1
  94.         mov bx,word ptr xp[si]
  95.         cmp bx,320
  96.         jae @skip
  97.         shl ax,6
  98.         mov di,ax
  99.         shl ax,2
  100.         add di,ax
  101.         add di,bx
  102.         xor al,al
  103.         mov [es:di],al
  104.        @skip:
  105.       end;
  106.  
  107.       x := (sintab[(phiy+192) mod 255] * dot[n].x
  108.      {^^^^  ^^^^^^^^^^^^^^^^^^^^^^^^^^ ^ ^^^^^^^^
  109.       9     1                          3 2 }
  110.  
  111.             - sintab[phiy] * dot[n].z) div 128;
  112.           { ^ ^^^^^^^^^^^^ ^ ^^^^^^^^  ^^^^^^^
  113.             7 4            6 5         8 }
  114.  
  115.       (*
  116.       asm
  117.         xor ah,ah                      { 1 }
  118.         mov al,phiy
  119.         add al,192
  120.         mov si,ax
  121.         mov ax,word ptr sintab[si]
  122.         mov si,n                       { 2 }
  123.         mov dx,word ptr dot[si].x
  124.         mul dx                         { 3 }
  125.         mov cx,ax
  126.         mov dx,word ptr dot[si].z      { 5 }
  127.         mov al,phiy                    { 4 }
  128.         mov si,ax
  129.         mov ax,word ptr sintab[si]
  130.         mul dx                         { 6 }
  131.         sub cx,ax                      { 7 }
  132.         shr cx,7                       { 8 }
  133.         mov x,cx                       { 9 }
  134.       end;
  135.       *)
  136.  
  137.       z := (sintab[(phiy+192) mod 255]*dot[n].z+sintab[phiy]*dot[n].x) div 128;
  138.       xp[n] := 160+(x*dist) div (z-dist);
  139.       yp[n] := 100+(dot[n].y*dist) div (z-dist);
  140.  
  141.       {
  142.       asm
  143.         mov ax,x
  144.         mov dx,dist
  145.         mul dx
  146.         mov dx,z
  147.         sub dx,dist
  148.         div dx
  149.         add ax,160
  150.  
  151.         (* can't assign ax to xp[n] !? *)
  152.  
  153.       end;
  154.       }
  155.  
  156.       asm
  157.         mov si,n
  158.         mov al,byte ptr yp[si]
  159.         cmp al,200
  160.         jae @skip
  161.         shl si,1
  162.         mov bx,word ptr xp[si]
  163.         cmp bx,320
  164.         jae @skip
  165.         shl ax,6
  166.         mov di,ax
  167.         shl ax,2
  168.         add di,ax
  169.         add di,bx
  170.         mov ax,z
  171.         shr ax,3
  172.         add ax,30
  173.         mov [es:di],al
  174.        @skip:
  175.       end;
  176.     end;
  177.     asm inc phiy end;
  178.     setpal(0,0,0,0);
  179.   until esc;
  180.   asm sti end;
  181. end;
  182.  
  183. {----------------------------------------------------------------------------}
  184.  
  185. begin
  186.   setvideo($13);
  187.   Init;
  188.   rotation;
  189.   textmode(lastmode);
  190. end.
  191.